Assignment:  Writing functions and bar graphs
By:          Daniel B. Carr

Topics       1. Writing functions
             1.1 A simple example
             1.2 Function arguments 
             1.3 Variable scope
             1.4 Debugging tools exist 
				
             2. Colored Matrix Function
             3. Horizontal bar plot panels for multiple
                categorical variables, and example   

Due          2. Complete function definition and plot
             3. Plot

1.  Writing R functions

Writing functions in R provides a way build tools and to 
extend the language.  A group of functions that serve a
task can be bundled together as a package and made available
to the R community provided they meet the standards for documentation
and test cases.  Here we focus on functions for ourselves.  

Analyst written functions, like other objects can be saved in the
workspace.  Then they stay around unless explicitly 
removed or redefined.  Access is also temporarily lost if 
was change our active workspace and don't also provide access to the
previous workspace.    

1.1  A simple example_______________________________

Often functions check the argument(s) to see if they are valid.  
The function below provides an example.  

##Run
squared = function(x){
	if(!is.numeric(x))stop('Argument must be numeric')
	return(x^2)
}
##End

# tests

## Run
squared("a")
squared(NULL)
squared(c(1,3,5,7))
##End

##Run
mat = matrix(1:6,ncol=3,byrow=T)
squared(mat)
##End

##Run
# put 105 standard normal numbers in a 3 x 5 x 7 array
mydat = array(rnorm(n=3*5*7),dim=c(3,5,7)) 
squared(mydat)
##End

When there are many values, hand comparison
gets tedious and error prone. 
There are ways to simplify the task
 
##Run
range(mydat^2-squared(mydat))
all(mydat^2==squared(mydat))
##End

Recently I learned about some handy functions.

##Run
all.equal(mydat^2,squared(mydat))
identical(mydat^2,squared(mydat))
##End

Documents warns that all.equal() should not be used in
if() statements it doesn't always return a simple
TRUE or FALSE.  

1.2  Function arguments________________________

Commas separate arguments.

Arguments in a function call are identified by
keywords or positions. 
   The positions are used after removing
   arguments identified by keyword.

   In the call to a function, only enough keyword letters
   are needed to uniquely identify the keyword intended 
   in the function definition.   

   Arguments in a function definition can have defaults
   give by keyword = value


##Run
myLinear = function(x,aa=1,bb=0){
  y = aa*x+bb
  return(y)  # We could just return aa*x+bb
}
##End

##Run
myLinear(1:10,aa=2)
myLinear(b=3,a=2,1:10)   # 1:10 becomes x 
##End

R uses lazy evaluation. Default expressions don't
have to be defined until they are needed.   

##Run
myLinear = function(x,a=1,b=sqrt(y)){
	y = 49
	return(a*x+b)
}
##End

##Run
myLinear(2)
#End

1.3  Variable scope_________________________________

The scope of variables created in a function is
local to the function. In R this scope include
(sub) functions defined inside the function when it
was defined

1.4 Debugging tools_________________________________

R has debugging tools such as browser() that are not explained
here.  

2.  Finishing writing a function called coloredMatrix______________________

##Finish by filling in values or calculations for ?? and Run    
coloredMatrix = function(mat,nbreaks=5,colors,
                title="",padx=.5,pady=.5,border=NULL){

# Define colors if not supplied
  if(missing(colors)){
      # 5 Diverging colors from Color Brewer
      colors=c("#2C7BB6","#ABD9E9","#FFFFBF","#FDAE61","#CA373B")
   }

# mat is a matrix whose values are used to determine the color of rectangles
# By default
#     The function cut(), further below, recodes the matrix values into numbers 1 to 5
#     These numbers then subscript a vector of five colors called colors.  
#     A low matrix value will have code 1 and be represented as a rectangle
#     with the first color


# The rectangles will form a matrix.
# We need to generate x and y coordinates for the centers of the rectangles
# We start with coordinates yloc and xloc of a single row and a single column  
   nr = nrow(mat)
   nc = ncol(mat)
   yloc = nr:1     # Most people think of the top row as row 1
   xloc = 1:nc
  
#  Next we expand these two vectors to longer vectors, y and x
#  that include all combinations of yloc and xloc
#  varying the row locations, yloc, the fastest 
   xyLat = expand.grid(list(y=yloc,x=xloc))
   y=xyLat$y
   x=xyLat$x

# Now we recode the value in mat into integers 1 to 5
# The cut() function below convert mat into a vector,
# varying the row subscript fastest
# It finds the range of values of in mat
# and divides this into 5 equal intervals
# Values ties with the upper bound of an interval
# are include in the interval.  
# The minimum values will not be included in the 
# lowest interval without setting an argument to true.
   
matColorSubs = cut(mat,breaks=5,include.lowest=T)

# Finally produce the plot

   plot(c(1-padx,padx+nc),c(1-pady,pady+nr),type="n",axes=F,
        xlab="",ylab="",main=title,cex=1.2)
  dx = ??
  dy = ??
  rect(x-dx,y-dy,x+dx,y+dy,border=border,col=colors[matColorSubs])

  return("Done")
}

mat = matrix(rnorm(2500),ncol=50)
coloredMatrix(mat,border="gray")

##End

3. Juxtaposed horizontal bars panels for several categorical variables

The original plot and the data come from the Bureau of Transportation
Statistics.  The design made it difficult to make natural comparisons
such as males versus females.  

This example redesigns the original to facilitate making the natural
comparisons.

# 3.1  Hand Entering Data with labels__________________________________
##Run

Income = c(1.6,4.7,6.3)
names(Income) = c('Under $25,000','$25,000 to $50,000','Over $50,000')

Race = c(1.9,2.2,2.8,4.4)
names(Race) = c('Blacks','Hispanics','Asians and Pacific Islanders','Whites')

Sex = c(3.5,4.5)
names(Sex) = c('Female','Male')

a18.24 = c(0.4,1.5,1.2,.7)
a25.34 = c(1.0,1.5,1.1,.5)
a35.44 = c(1.7,1.2,1.4,.6)
a45.54 = c(1.9,1.5,1.7,.9)
a55.64 = c(1.2,1.6,1.7,.8)
a65.up = c(0.4,1.1,0.9,.5)

Age = c(2.3,sum(a18.24),sum(a25.34),sum(a35.44),sum(a45.54),sum(a55.64),2.9)
names(Age) = c('Under 18','18 to 24','25 to 34','35 to 44','45 to 54',
                '55 to 64','Over 65')

Married = c(3.7,5.2)
names(Married) = c('With Children Under 18','Without Children')

datList=list(Sex=Sex,Married=Married,Income=Income,Race=Race,Age=Age)
##End


# 3.2 Define bar plot function for horizontal panels of a plot_________________
##Run

panelBars = function(x,xMax,little,xshift=.04,label=NULL,
                    barFill="skyblue",border="gray",
                    textCol="white",textDecimal=1,textCex=.86,labCex=1,
                    numberCol="black",
                    barHeightFraction=2/3){
   nbar = length(x)
   y = nbar:1
   dy= barHeightFraction/2
   rect(0,y-dy,x,y+dy,col=barFill,border=border)
   for (i in 1:nbar){
      if(x[i] < little){
         text(x[i]+xshift,y[i],
         paste(format(x[i],textDecimal),names(x[i]),sep=" : "),
              col=numberCol,adj=0,cex=textCex,font=2)
      } else {
          text(x[i]-xshift,y[i],format(x[i],textDecimal),
              col=textCol,adj=1,cex=textCex,font=2)

#        text(x[i]+xshift,y[i],format(x[i],textDecimal),
#             col=numberCol,adj=0,cex=textCex,font=2)
         text(xshift,y[i],names(x[i]),
              col=textCol,adj=0,cex=textCex,font=2)              
      }   
   }   
   mtext(text=label,side=2,line=.8,las=2,cex=labCex)
}
##End

# 3.3  Produce the plot______________________________________________
##Run

windows(width=10,height=8)
textCex=.86
panFill=c(rgb(.82,.82,1),rgb(.85,.78,1.))
barFill = c(rgb(0,0,.7),rgb(.4,.1,.6))
border = c('black','black')
pan = panelLayout(nr=5,nc=1,
         leftMar=.8,topMar=.5,bottomMar=.7,
         rowSize=c(2,2,3,4,7)+1) # panel heights
panBlock = panelLayout(nr=1,nc=1,leftMar=.8,topMar=.5,bottomMar=.7)

xMax = 1.04*max(unlist(datList))
xGrid=panelInbounds(c(0,xMax))
nam = names(datList)
for(i in 1:5){
   flip = (i+1)%%2+1
   panelSelect(pan,i,1)
   x = datList[[i]]
   nbar=length(x)
   panelScale(rx=c(0,xMax),ry=c(.3,nbar+.7))
   panelFill(col=panFill[flip])
   panelGrid(x=xGrid,col="white",lwd=2)
   if(i==5){
       axis(side=1,at=xGrid,tck=0,mgp=c(2,.2,0),cex.axis=textCex)
       mtext("Average Trips Greater Than 100 Miles One Way",side=1,line=1.6) 
   }
   panelOutline()
   panelBars(x,xMax=xMax,little=1,xs=.03,
   label=nam[i],barFill=barFill[flip],textCex=textCex)
}

panelSelect(panBlock,1,1)
panelScale()
panelOutline()
mtext(side=3,line=1.8,"Long Distance Trips Per Person for 1995",adj=.5,cex=1.5)

##End